home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / classy.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  1KB  |  44 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defmodule classy
  8.  
  9.   (standard0) ()
  10.  
  11.   (defun class-slots (cl)
  12.     (mapcar slot-description-name
  13.         (class-slot-descriptions cl)))
  14.  
  15.   (defun class-hierarchy ()
  16.     (do-class-hierarchy (list object) 0))
  17.  
  18.   (defun do-class-hierarchy (objlist depth)
  19.     (print-indent (car objlist) depth)
  20.     (if (class-slots (car objlist))
  21.     (progn
  22.       (prin "slots: ")
  23.       (print-indent (class-slots (car objlist)) depth))
  24.         nil)
  25.     (if (class-direct-subclasses (car objlist))
  26.     (do-class-hierarchy (class-direct-subclasses (car objlist))
  27.                 (+ depth 4))
  28.         nil)
  29.     (if (cdr objlist)
  30.     (do-class-hierarchy (cdr objlist) depth)
  31.         nil))
  32.  
  33.   (defun print-indent (obj depth)
  34.     (if (= depth 0)
  35.     (print obj)
  36.         (progn
  37.       (prin " ")
  38.       (print-indent obj (- depth 1)))))
  39.  
  40.   (export class-hierarchy)
  41.  
  42. )
  43.  
  44.